home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / dbapg.arc / PRINTDOC.PRG < prev    next >
Encoding:
Text File  |  1984-08-12  |  8.3 KB  |  291 lines
  1. * Program.: PRINTDOC.PRG
  2. * Author..: Luis A. Castro
  3. * Date....: 06/26/84
  4. * Notice..: Copyright 1984, Luis A. Castro, All Rights Reserved
  5. * Version.: dBASE II, version 2.4x
  6. * Notes...: Prints system documentation.  Uses PRINTDOC.DBF
  7. *           with the field: PRINTLINE-C-254
  8. *
  9. SET TALK OFF
  10. SET BELL OFF
  11. SET COLON OFF
  12. * ---Initialize the default output text file.
  13. STORE "PRINTDOC.TXT" TO outfile
  14. SET ALTERNATE TO &outfile
  15.  
  16. DO WHILE T
  17.  
  18. ERASE
  19. @  1, 0 SAY "========================================"
  20. @  1,40 SAY "========================================"
  21. @  2, 0 SAY "||"
  22. @  2,21 SAY "P R I N T    D O C U M E N T A T I O N"
  23. @  2,78 SAY "||"
  24. @  3, 0 SAY "========================================"
  25. @  3,40 SAY "========================================"
  26. @  5,25 SAY " 0. exit"
  27. @  6,25 SAY " 1. data/index file structures"
  28. @  7,25 SAY " 2. memory file structures"
  29. @  8,25 SAY " 3. database data dictionary"
  30. @  9,25 SAY " 4. change output file name"
  31. *
  32. STORE "Current output file :" + outfile TO filename
  33. @ 15, (80 - LEN( filename )) / 2 SAY filename
  34. *
  35. STORE  5 TO selectnum
  36. DO WHILE selectnum < 0 .OR. selectnum >  4
  37.    STORE " " TO select
  38.    @ 12,33 SAY " select : : "
  39.    @ 12,42 GET select PICTURE "#"
  40.    READ
  41.    STORE VAL(select) TO selectnum
  42. ENDDO
  43.  
  44. DO CASE
  45.  
  46. CASE selectnum= 0
  47.    SET COLON ON
  48.    SET BELL ON
  49.    SET TALK ON
  50.    CLEAR
  51.    RETURN
  52. CASE selectnum= 1
  53. *  DO data/index file structures
  54.    ERASE
  55.    @ 2, 0 SAY "DATA/INDEX FILE STRUCTURES"
  56.    @ 2,72 SAY DATE()
  57.    @ 3, 0 SAY "========================================"
  58.    @ 3,40 SAY "========================================"
  59.    ACCEPT "Enter datafile name " TO filename
  60.    STORE !( TRIM( filename ) ) + "." TO filename
  61.    STORE $( filename, 1, @(".",filename) - 1 ) TO filename
  62.    DO CASE
  63.       CASE filename = " "
  64.          LOOP
  65.       CASE .NOT. FILE( filename + ".DBF" )
  66.          ? "FILE DOES NOT EXIST"
  67.          WAIT
  68.          LOOP
  69.    ENDCASE
  70.    ACCEPT "Enter INDEX files [separated by commas] " TO indexline
  71.    STORE indexline + " ,*" TO indexline
  72.    ?
  73.    * ---List the datafile structure.
  74.    USE &filename
  75.    SET ALTERNATE ON
  76.    LIST STRUCTURE
  77.    SET ALTERNATE OFF
  78.    USE
  79.    * ---Get index files.
  80.    IF indexline <> " "
  81.       SET ALTERNATE ON
  82.       ?
  83.       ? "Indexes:"
  84.       SET ALTERNATE OFF
  85.       USE Printdoc.dbf
  86.       COPY STRUCTURE TO Printndx.$$$
  87.       USE Printndx.$$$
  88.       * ---Get one index file at a time.
  89.       DO WHILE $( indexline, 1, 1 ) <> "*"
  90.          *
  91.          DO WHILE $( indexline, 1 ) = " "
  92.             * ---Strip leading blanks.
  93.             STORE $( indexline, 2 ) TO indexline
  94.          ENDDO
  95.          * ---Get index file name.
  96.          STORE @(",",indexline) TO pos
  97.          STORE TRIM( $( indexline, 1, pos - 1 ) ) TO token
  98.          STORE $( indexline, pos + 1 ) TO indexline
  99.          STORE !( TRIM( token ) ) + "." TO token
  100.          STORE $( token, 1, @(".",token) - 1 ) TO token
  101.          SET ALTERNATE ON
  102.          ? "  " + token + " = "
  103.          SET ALTERNATE OFF
  104.          STORE token + ".NDX" TO token
  105.          IF .NOT. FILE( token )
  106.             ? "FILE DOES NOT EXIST - ",token
  107.             LOOP
  108.          ENDIF
  109.          * ---Get index key expression.  
  110.          * ---This method will NOT always work, because
  111.          * ---dBASE II does not accept some control chars.
  112.          * ---You may have to edit the expression, afterward. 
  113.          APPEND FROM &token SDF FOR # < 2
  114.          GO TOP
  115.          STORE $( Printline, 11, 100 ) TO key:expr
  116.          STORE $( key:expr, 1, 1 ) TO char
  117.          STORE 1 TO pos
  118.          STORE " " TO expression
  119.          DO WHILE RANK( char ) <> 0 .AND. pos < 100
  120.             STORE expression + char TO expression
  121.             STORE pos + 1 TO pos
  122.             STORE $( key:expr, pos, 1 ) TO char
  123.          ENDDO
  124.          SET ALTERNATE ON
  125.          ?? expression
  126.          SET ALTERNATE OFF
  127.          DELETE ALL
  128.          PACK
  129.       ENDDO
  130.       USE
  131.       DELETE FILE Printndx.$$$
  132.    ENDIF
  133.    SET ALTERNATE ON
  134.    ?
  135.    ? "Linkages:
  136.    ? "  <-->>"
  137.    ?
  138.    ? ".PA"
  139.    ?
  140.    SET ALTERNATE OFF
  141.    RELEASE ALL EXCEPT outfile
  142.    *
  143. CASE selectnum= 2
  144. *  DO memory file structures
  145.    ERASE
  146.    @ 2, 0 SAY "MEMORY FILE STRUCTURES"
  147.    @ 2,72 SAY DATE()
  148.    @ 3, 0 SAY "========================================"
  149.    @ 3,40 SAY "========================================"
  150.    ACCEPT "Enter MEMORY file name " TO filename
  151.    STORE !( TRIM( filename ) ) + "." TO filename
  152.    STORE $( filename, 1, @(".",filename) - 1 ) TO filename
  153.    DO CASE
  154.       CASE filename = " "
  155.          LOOP
  156.       CASE .NOT. FILE( filename + ".MEM" )
  157.          ? "FILE DOES NOT EXIST"
  158.          WAIT
  159.          LOOP
  160.    ENDCASE
  161.    SAVE TO Printmem.mem 
  162.    RELEASE ALL EXCEPT filename
  163.    RESTORE FROM &filename ADDITIVE
  164.    ?
  165.    * ---List the memory variables.
  166.    SET ALTERNATE ON
  167.    ? filename + ".MEM"
  168.    ? $( "------------", 1, LEN( filename ) + 4 )
  169.    LIST MEMORY
  170.    ?
  171.    ? ".PA"
  172.    ?
  173.    SET ALTERNATE OFF
  174.    RELEASE ALL
  175.    RESTORE FROM Printmem.mem
  176.    RELEASE ALL EXCEPT outfile
  177. CASE selectnum= 3
  178. *  DO database data dictionary
  179.    ERASE
  180.    @ 2, 0 SAY "DATABASE DATA DICTIONARY"
  181.    @ 2,72 SAY DATE()
  182.    @ 3, 0 SAY "========================================"
  183.    @ 3,40 SAY "========================================"
  184.    @ 5, 0 SAY "Enter datafile list [separated by commas]"
  185.    ACCEPT TO line
  186.    IF line = " "
  187.       LOOP
  188.    ENDIF
  189.    ?
  190.    STORE line + ",*" TO line
  191.    * ---Get field names.
  192.    USE Printdoc.dbf
  193.    COPY STRUCTURE TO Printdat.$$$
  194.    USE Printdat.$$$
  195.    INDEX ON $(Printline,1,10) TO Printndx.$$$
  196.    * ---Get filenames.
  197.    DO WHILE $(line,1,1) <> "*"
  198.       *
  199.       DO WHILE $(line,1) = " " .AND. LEN(line) > 1
  200.          * ---Strip leading blanks.
  201.          STORE $(line,2) TO line
  202.       ENDDO
  203.       * ---Get one file name.
  204.       STORE TRIM( $( line, 1, @(",",line) - 1 ) ) TO token
  205.       STORE $( line, @(",",line) + 1 ) TO line
  206.       STORE !( TRIM( token ) ) + "." TO token
  207.       STORE $( token, 1, @(".",token) - 1 ) TO token
  208.       IF .NOT. FILE( token + ".DBF" )
  209.          ? "FILE DOES NOT EXIST"
  210.          LOOP
  211.       ENDIF
  212.       SELECT SECONDARY
  213.       USE &token
  214.       COPY STRUCTURE EXTENDED TO Printdbf.$$$
  215.       USE Printdbf.$$$
  216.       DO WHILE .NOT. EOF
  217.          STORE Field:name TO mkey
  218.          SELECT PRIMARY
  219.          FIND &mkey
  220.          IF # <> 0
  221.             STORE LEN( TRIM( Printline ) ) - 15 TO value
  222.             STORE ( value - 10 * INT( value / 10 ) ) TO modula
  223.             STORE $( STR(0,11), 1, 10 - modula ) TO string
  224.             REPLACE Printline WITH TRIM(Printline)+string+token
  225.          ELSE
  226.             APPEND BLANK
  227.             REPLACE Printline WITH S.Field:name+"     "+token
  228.          ENDIF
  229.          SELECT SECONDARY
  230.          ?? "."
  231.          SKIP
  232.       ENDDO
  233.    ENDDO
  234.    USE
  235.    SELECT PRIMARY
  236.    ?
  237.    SET ALTERNATE ON
  238.    ? "DATABASE DATA DICTIONARY"
  239.    ? "========================"
  240.    ?
  241.    ? "FIELD NAME       DATA FILE OCCURRENCES"
  242.    ? "----------     -----------------------------------"
  243.    GO TOP
  244.    DO WHILE .NOT. EOF
  245.       ? TRIM(Printline)
  246.       SKIP
  247.    ENDDO
  248.    ?
  249.    ? ".PA"
  250.    ?
  251.    SET ALTERNATE OFF
  252.    USE
  253.    DELETE FILE Printdat.$$$
  254.    DELETE FILE Printdbf.$$$
  255.    DELETE FILE Printndx.$$$
  256.    RELEASE ALL EXCEPT outfile
  257. CASE selectnum= 4
  258. *  DO change output file name
  259.    ERASE
  260.    @ 2, 0 SAY "CHANGE OUTPUT FILE NAME"
  261.    @ 2,72 SAY DATE()
  262.    @ 3, 0 SAY "========================================"
  263.    @ 3,40 SAY "========================================"
  264.    ACCEPT "Enter new file name " TO newfile
  265.    STORE !( TRIM( newfile ) ) + "." TO newfile
  266.    STORE $( newfile, 1, @(".",newfile) ) + "TXT" TO newfile
  267.    DO CASE
  268.       CASE newfile = outfile
  269.          STORE " " TO select
  270.          @ 6,0 SAY "TEXT FILE IS ALREADY OPEN.  " +;
  271.                    "Restart it? [Y/N] ";
  272.                GET select PICTURE "!"
  273.          READ
  274.       CASE FILE( newfile )
  275.          STORE " " TO select
  276.          @ 6,0 SAY "TEXT FILE ALREADY EXISTS.  " +;
  277.                    "Delete it? [Y/N] ";
  278.                GET select PICTURE "!"
  279.          READ
  280.       CASE newfile <> " .TXT"
  281.          STORE "Y" TO select
  282.    ENDCASE
  283.    IF select = "Y"
  284.       STORE newfile TO outfile
  285.       SET ALTERNATE TO &outfile
  286.    ENDIF
  287. ENDCASE
  288.  
  289. ENDDO T
  290. * EOF: PRINTDOC.PRG
  291.